home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MAIL.SWG / 0017_FIDONET Traffic.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-09  |  10KB  |  337 lines
  1. {
  2.   The following source uses the FIDONET unit which will follow in the next
  3. message.. It is a modified version of the origionsl FIDOPAS archive: }
  4.  
  5. Unit FidoNet;
  6.  
  7. INTERFACE
  8.  
  9. Uses Dos,
  10.      Crt,
  11.      StrnTTT5,
  12.      MiscTTT5;
  13.  
  14. Type
  15.   NetMsg = record
  16.     From,                            { Name of sender              }
  17.     Too           : String[35];      { Name of receiver            }
  18.     Subject       : String[71];      { Msg subject                 }
  19.     DateTime      : String[19];      { Msg date/time, see below    }
  20.     Times ,                          { Times message has been read }
  21.     DestNode,                        { Destination node number     }
  22.     OrgNode,                         { Originating node number     }
  23.     Cost,                            { Cost - 0 if not supported   }
  24.     OrgNet,                          { Originating net number      }
  25.     DestNet       : word;            { Destination net number      }
  26.     DateWritten,                     { Date/time written           }
  27.     SentReceived  : longint;         { Date/time sent/rcvd         }
  28.     ReplyTO,                         { # of next message in replys }
  29.     Attr,                            { Message status bits         }
  30.     NextReply     : word;            { Number of previous message  }
  31.     AreaName   : String[20];         {AreaName (Only if Echomail)  }
  32.   end;
  33.  
  34. Const
  35.         _private    = $0001;
  36.         _crash      = $0002;
  37.         _received   = $0004;
  38.         _sent       = $0008;
  39.         _fileattach = $0010;
  40.         _transit    = $0020;
  41.         _orphan     = $0040;
  42.         _killsent   = $0080;
  43.         _local      = $0100;   { required on all locally entered messages! }
  44.         _hold       = $0200;
  45.         _direct     = $0400;
  46.         _filereq    = $0800;
  47.         _updatereq  = $8000;
  48.  
  49.       Status    : Array[1..12] Of String[3] = ('Jan','Feb','Mar','Apr',
  50.                                                'May','Jun','Jul','Aug',
  51.                                                'Sep','Oct','Nov','Dec');
  52. Var Net    : NetMsg;
  53.  
  54. Function  NetMessage     : String;
  55. Function  GetPath(Var FName : String) : Boolean;
  56. Function  GetNet(GN : String) : String;
  57. Function  GetNode(GN : String) : String;
  58. Function  MsgDateStamp   : String;
  59. Function  LastMsgNum( _NetPath : String ) : Integer;
  60. Function  Hex (n : word) : String;
  61. Procedure ExpandNodeNumbers(Var List : String; VAR TotalNumber : Integer );
  62. Procedure Conv_NetNode(NetNode : String; VAR Net, Node : Word);
  63.  
  64. IMPLEMENTATION
  65.  
  66. Function NetMessage : String;  { Returns a NetMessage header string }
  67. Var Hdr : String;
  68. Begin
  69.   Hdr := '';
  70.  
  71.   Hdr := PadLeft(Net.From,36,#0);
  72.   Hdr := Hdr + PadLeft(Net.Too,36,#0)
  73.              + PadLeft(Net.Subject,72,#0)
  74.              + PadRight(Net.DateTime,19,' ')+#0
  75.              + Chr(Lo(Net.Times))+Chr(Hi(Net.Times))
  76.              + Chr(Lo(Net.DestNode))+Chr(Hi(Net.DestNode))
  77.              + Chr(Lo(Net.OrgNode))+Chr(Hi(Net.OrgNode))
  78.              + Chr(Lo(Net.Cost))+Chr(Hi(Net.Cost))
  79.              + Chr(Lo(Net.OrgNet))+Chr(Hi(Net.OrgNet))
  80.              + Chr(Lo(Net.DestNet))+Chr(Hi(Net.DestNet))
  81.              + #0#0#0#0#0#0#0#0
  82.              + Chr(Lo(Net.ReplyTo))+Chr(Hi(Net.ReplyTo))
  83.              + Chr(Lo(Net.Attr))+Chr(Hi(Net.Attr))
  84.              + Chr(Lo(Net.NextReply))+Chr(Hi(Net.NextReply))
  85.              + Upper(Net.AreaName);
  86.   NetMessage := Hdr;
  87. End;
  88.  
  89. Function GetPath(Var FName : String) : Boolean;
  90. { Returns the FULL Path and filename for a file if it is found in the path. }
  91. Var Str1,Str2 : String;
  92.     NR        : Byte;
  93.     HomeDir   : String;
  94.  
  95. Begin
  96.   HomeDir := FExpand(FName);
  97.   If Exist(HomeDir) Then Begin
  98.                   FName := HomeDir;
  99.                   GetPath := True;
  100.                   Exit;
  101.                 End;
  102.  
  103.   Str1 := GetEnv('PATH');
  104.   For NR := 1 to Length(Str1) DO IF Str1[NR] = ';' Then Str1[NR] := ' ';
  105.   For NR := 1 to WordCnt(Str1) DO
  106.    Begin
  107.     Str2 := ExtractWords(NR,1,Str1)+'\'+FName;
  108.     IF Exist(Str2) Then Begin
  109.       FName := Str2;
  110.       GetPath := True;
  111.       Exit;
  112.     End;
  113.    End;
  114.    GetPath := False;
  115. End;
  116.  
  117. Function MsgDateStamp : String; { Creates Fido standard- 01 Jan 89 21:05:18 }
  118. Var h,m,s,hs          : Word;   { header time/date stamp   }
  119.     y,mo,d,dow        : Word;
  120.     Tmp,
  121.     o1,o2,o3          : String;
  122.  
  123. Begin
  124.   o1 := '';
  125.   o2 := '';
  126.   o3 := '';
  127.   tmp := '';
  128.   GetDate(y,mo,d,dow);
  129.   GetTime(h,m,s,hs);
  130.   o1 := PadRight(Int_To_Str(d),2,'0');
  131.   o2 := Status[mo];
  132.   o3 := Last(2,Int_To_Str(y));
  133.   Tmp := Concat( o1,' ',o2,' ',o3,'  ');
  134.   o1 := PadRight(Int_To_Str(h),2,'0');
  135.   o2 := PadRight(Int_To_Str(m),2,'0');
  136.   o3 := PadRight(Int_To_Str(s),2,'0');
  137.   Tmp := Tmp + Concat(o1,':',o2,':',o3);
  138.   MsgDateStamp := Tmp;
  139. End;
  140.  
  141. Function MsgToNum(Fnm : String ):Integer; { Used Internally by LastMsgNum }
  142. Var p : Byte;
  143. Begin
  144.   p        := Pos('.',Fnm);
  145.   Fnm      := First(p-1,Fnm);
  146.   MsgToNum := Str_To_Int(Fnm);
  147. End;
  148.  
  149. Function LastMsgNum( _NetPath : String ) : Integer;
  150. { Returns the highest numbered xxx.MSG in NetPath directory }
  151. Var
  152.     _Path   : String;
  153.     Temp1,
  154.     Temp2   : String;
  155.     Len     : Byte;
  156.     DxirInf  : SearchRec;
  157.     Num,
  158.     Num1    : Integer;
  159.  
  160. Begin
  161.   Num   := 0;
  162.   Num1  := 0;
  163.   Temp1 := '';
  164.   Temp2 := '';
  165.   _Path := '';
  166.   _Path := _NetPath + '\*.MSG';
  167.  
  168.   FindFirst( _Path, Archive, DxirInf );
  169.   While DosError = 0 DO
  170.   Begin
  171.     Temp1 := DxirInf.Name;
  172.     Num1 := MsgToNum(Temp1);
  173.     IF Num1 > Num Then Num := Num1;
  174.     FindNext(DxirInf);
  175.   End;
  176.  
  177.   IF Num = 0 Then Num := 1;
  178.   LastMsgNum := Num;
  179. End;
  180.  
  181. Function Hex(N : Word) : String;
  182. { Converts an integer or word to it's Hex equivelent }
  183. Var
  184.   L : string[16];
  185.   BHi,
  186.   BLo : byte;
  187.  
  188. Begin
  189.   L := '0123456789abcdef';
  190.   BHi := Hi(n);
  191.   BLo := Lo(n);
  192.   Hex := copy(L,succ(BHi shr 4),1) +
  193.          copy(L,succ(BHi and 15),1) +
  194.          copy(L,succ(BLo shr 4),1) +
  195.          copy(L,succ(BLo and 15),1);
  196. End;
  197.  
  198. Function GetNet( GN : String ) : String;
  199. { Returns the NET portion of a Net/Node string }
  200. Var P : Byte;
  201. Begin
  202.   P := Pos('/',GN);
  203.   GetNet := First(P-1,GN);
  204. End;
  205.  
  206. Function GetNode( GN : String ) : String;
  207. { Returns the NODE portion of a Net/Node string }
  208. Var P : Byte;
  209. Begin
  210.   P := Pos('/',GN);
  211.   GetNode := Last(Length(GN)-P,GN);
  212. End;
  213.  
  214. Procedure ExpandNodeNumbers(Var List : String; VAR TotalNumber : Integer );
  215.         { Expands a list of short form node numbers to thier proper       }
  216.         { Net/Node representations. Example:                              }
  217.         { The string: 170/100 101 102 5 114/12 15 17 166/225 226          }
  218.         { Would return: 170/100 170/101 170/102 170/5 114/12 114/15 etc.. }
  219. Var Net,NetNode  : String[10];
  220.     HoldStr,
  221.     WS1          : String;
  222.     N1           : Integer;
  223. Begin
  224.   Net := '';
  225.   NetNode := '';
  226.   HoldStr := '';
  227.   WS1 := '';
  228.   N1 := 0;
  229.   TotalNumber := 0;
  230.   TotalNumber := WordCnt(List);
  231.  
  232.   For N1 := 1 to TotalNumber DO Begin
  233.     WS1 := ExtractWords(N1,1,List);
  234.     IF Pos('/',WS1) <> 0 Then Begin Net := GetNet(WS1)+'/'; NetNode := WS1;
  235.     End ELSE NetNode := Net+WS1;
  236.     HoldStr := HoldStr + ' ' + Strip('A',' ',NetNode);
  237.   End;
  238. End;
  239.  
  240. Procedure Conv_NetNode(NetNode : String; VAR Net, Node : Word);
  241.          { Returns NET and NODE as words from a Net/Node string }
  242. Var WStr : String[6];
  243. Begin
  244.   Wstr := GetNet(NetNode);
  245.   Net  := Str_To_Int(Wstr);
  246.   Wstr := GetNode(NetNode);
  247.   Node := Str_To_Int(Wstr);
  248. End;
  249.  
  250. Begin
  251.   { Initialize the data structures }
  252.   FillChar(Net,SizeOf(Net),#0);
  253. End.
  254.  
  255. { --------------------- DEMO PROGRAM -------------------------- }
  256. Program Test;
  257.  
  258. Uses
  259.   Crt,
  260.   FidoNet,
  261.   StrnTTT5;      {TechnoJocks Turbo Toolkit StrnTTT5 unit}
  262.  
  263. var
  264.   NetPath   : String;
  265.  
  266. Procedure Create_NetMessage(FileName : String );
  267. Var LastOne,i : Integer;
  268.     Msg_Name  : String;
  269.     Attrib    : Word;
  270.     MsgFil,
  271.     Inputfile : Text;
  272.     Header,
  273.     S         : String;
  274.  
  275. Begin
  276.   Header   := '';
  277.   S        := '';
  278.   LastOne  := 0;
  279.   Msg_Name := '';
  280.   Attrib   := _Local + _Private;
  281.   With Net DO Begin
  282.     From      := 'Lucas Nealan';
  283.     Too       := 'Anyone';
  284.     Subject   := 'Testing the FidoNet Unit...';
  285.     DateTime  := MsgDateStamp;
  286.     Times     := 0;
  287.     DestNode  := 0;
  288.     OrgNode   := 100;
  289.     Cost      := 0;
  290.     OrgNet    := 31;
  291.     DestNet   := 22;
  292.     ReplyTo   := 0;
  293.     Attr      := Attrib;
  294.     NextReply := 0;
  295.   End;
  296.   Header := NetMessage;
  297.   LastOne := LastMsgNum(NetPath);
  298.   Inc(LastOne);
  299.   Msg_Name := NetPath+'\'+Int_To_Str(LastOne)+'.MSG';
  300.   Assign(MsgFil, Msg_Name );
  301.   Rewrite(MsgFil);
  302.   WriteLn(MsgFil,Header);
  303.   Assign(InputFile, FileName);
  304.   Reset(InputFile);
  305.   WriteLn(MsgFil,#1'INTL 20:22/0 20:31/100');
  306.   WriteLn(MsgFil,#1'PID Lucas'' *.MSG Util');
  307.   WriteLn(MsgFil,^A'FLAGS DIR');
  308.   While not Eof(InputFile) do begin
  309.     ReadLn(InputFile,S);
  310.     WriteLn(MsgFil,S);
  311.   end;
  312.   Flush(MsgFil);
  313.   Close(MsgFil);
  314.   Close(InputFile);
  315. end;
  316.  
  317. begin
  318.   ClrScr;
  319.   WriteLn;
  320.   WriteLn('Posting file: '+ParamStr(1));
  321.   WriteLn;
  322.   NetPath := 'D:\FD\NETMAIL';
  323.   Create_NetMessage(ParamStr(1));
  324. end.
  325.  
  326.   The INTL Kludge line is used to send messages through non standard network
  327. zones (20 in this example).  For fido standard zone 1 you may specify just the
  328. origin net and node as well as destination net and zone and it will default to
  329. zone 1.  Also with the direct flag you may either use the _Direct in the status
  330. or add your own FLAGS DIR kludge.
  331.  
  332.    Good luck!
  333.  
  334.                                         Lucas Nealan
  335.                                       Real World Programming
  336.  
  337.